/* poporca4.p - PURCHASE ORDER RECEIPT OVER RECEIPT TOLERANCE CHECKS          */
/* Copyright 1986 QAD Inc. All rights reserved.                               */
/* $Id:: poporca4.p 83236 2018-05-15 05:57:57Z ika                         $: */
/*                                                                            */
/* REVISION: 7.3     LAST MODIFIED: 09/14/93    BY: tjs *GE59*                */
/* REVISION: 7.3     LAST MODIFIED: 05/27/93    BY: tjs *FO47*                */
/* REVISION: 7.3     LAST MODIFIED: 02/14/95    BY: WUG *G0F7*                */
/* REVISION: 7.3     LAST MODIFIED: 03/29/95    BY: bcm *G0JN*                */
/* REVISION: 7.3     LAST MODIFIED: 03/29/95    BY: dzn *F0PN*                */
/* REVISION: 7.3     LAST MODIFIED: 08/07/95    BY: jym *G0TP*                */
/* REVISION: 7.3     LAST MODIFIED: 09/12/95    BY: vrn *G0X3*                */
/* REVISION: 7.4     LAST MODIFIED: 10/06/95    BY: vrn *G0XW*                */
/* REVISION: 8.5     LAST MODIFIED: 09/09/95    by: mwd *J053*                */
/* REVISION: 8.5     LAST MODIFIED: 04/09/96    by: rxm *H0KH*                */
/* REVISION: 8.5     LAST MODIFIED: 07/16/96    BY: rxm *G1SV*                */
/* REVISION: 8.6E    LAST MODIFIED: 05/09/98    BY: *L00Y* Jeff Wootton       */
/* REVISION: 8.6E    LAST MODIFIED: 06/17/98    BY: *L020* Charles Yen        */
/* REVISION: 8.6E    LAST MODIFIED: 11/12/98    BY: *J30M* Seema Varma        */
/* REVISION: 9.0     LAST MODIFIED: 04/16/99    BY: *J2DG* Reetu Kappor       */
/* REVISION: 9.1     LAST MODIFIED: 09/03/99    BY: *J3L4* Kedar Deherkar     */
/* REVISION: 9.1     LAST MODIFIED: 06/29/00    BY: *N0DK* Mugdha Tambe       */
/* REVISION: 9.1     LAST MODIFIED: 08/13/00    BY: *N0KQ* Mark Brown         */
/* Revision: 1.17    BY: Deepali Kotavadekar       DATE: 01/21/03 ECO: *N23Y* */
/* Revision: 1.19    BY: Paul Donnelly (SB)        DATE: 06/28/03 ECO: *Q00J* */
/* Revision: 1.20    BY: Dan Herman                DATE: 11/04/04 ECO: *M1V1* */
/* $Revision: 1.21 $ BY: Robin McCarthy            DATE: 05/31/06 ECO: *R02F* */
/*-Revision end---------------------------------------------------------------*/
 
/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/
 
/*! poporca4.p - PERFORM TOLERANCE CHECKING FOR PO RECEIPTS */
 
/*! NOT USED IN PO RETURNS (porvis.p) */
 
{us/bbi/mfdeclre.i}
 
/* SHARED VARIABLES */
define shared variable base_amt            like pod_pur_cost.
define shared variable conv_to_pod_um      like pod_um_conv.
define shared variable eff_date            like glt_effdate.
define shared variable exch_rate           like exr_rate.
define shared variable exch_rate2          like exr_rate.
define shared variable total_lotserial_qty like pod_qty_chg.
define shared variable total_received      like pod_qty_rcvd.
define shared variable updt_blnkt          like mfc_logical.
define shared variable po_recno            as   recid.
define shared variable pod_recno           as   recid.
define shared variable updt_blnkt_list     as   character no-undo.
 
/* LOCAL VARIABLES AND BUFFERS */
define variable divisor         like schd_discr_qty no-undo.
define variable newprice        like pod_pur_cost   no-undo.
define variable overage_qty     like pod_qty_rcvd   no-undo.
define variable qty_open        like pod_qty_rcvd   no-undo.
define variable dummy_disc      like pod_disc_pct   no-undo.
define variable mc-error-number like msg_nbr        no-undo.
define variable price_qty       as   decimal        no-undo.
define variable w-int1          as   integer        no-undo.
define variable w-int2          as   integer        no-undo.
define variable pc_recno        as   recid          no-undo.
define variable l_errlevel      as   integer        no-undo.
define variable l_config_msg    as   logical        no-undo.
 
define buffer poddet for pod_det.
 
define output parameter undotran like mfc_logical no-undo.
 
{us/px/pxmaint.i}
 
{us/mf/mfaimfg.i}  /* Common API constants and variables */
 
{us/po/popoit01.i} /* Define API purchase order temp tables  */
{us/mf/mfctit01.i} /* Define API transaction comments temp tables */
 
if c-application-mode = "API" then do:
 
   /* Get handle of API controller */
   {us/bbi/gprun.i ""gpaigh.p"" "(output ApiMethodHandle,
                           output ApiProgramName,
                           output ApiMethodName,
                           output ApiContextString)"}
 
   /* Get current purchase order transaction detail record */
   run getPurchaseOrderTransDetRecord in ApiMethodHandle
      (buffer ttPurchaseOrderTransDet).
 
end. /* IF c-application-mode = "API" */
 
undotran = yes.
do on error undo, retry:
 
   for first poc_ctrl
        where poc_ctrl.poc_domain =
      global_domain
   no-lock: end.
 
   for first po_mstr
      where recid(po_mstr) = po_recno
   no-lock: end.
 
   find pod_det where recid(pod_det) = pod_recno exclusive-lock.

   /* TOLERANCE MESSAGES ARE CONFIGURED FOR LEGAL DOCUMENT TYPE 51 */
   if poc_fiscal_confirm
      and can-find(first lgdc_ctrl 
                     where lgdc_domain    = global_domain
                     and   lgdc_form_code = "51")
      and pod_sched
   then
      l_config_msg = true.
   else
      l_config_msg = false.
 
   if pod_sched then do:
 
      {us/px/pxrun.i &PROC='checkMaxOrderQty' &PROGRAM='porcxr1.p'
               &PARAM="(buffer pod_det,
                       input total_lotserial_qty)"
               &NOAPPERROR=True
               &CATCHERROR=True}
 
      if return-value <> {&SUCCESS-RESULT} then do:
         if not batchrun
            and c-application-mode <> "API"
         then do:
            {us/gp/gpwait.i &INCLUDEPAUSE}.
         end. /* IF NOT batchrun  */
      end.
 
      if not pod_fix_pr then do:
         {us/px/pxrun.i &PROC='getScheduleReceiptCost' &PROGRAM='porcxr1.p'
                  &PARAM="(input eff_date,
                           input po_curr,
                           input po_vend,
                           input total_lotserial_qty,
                           buffer pod_det)"
                  &NOAPPERROR=True
                  &CATCHERROR=True}
      end. /* IF not pod_fix_pr */
 
      /* TOLERANCE CHECKING FOR SCHEDULED ORDERS */
      {us/px/pxrun.i &PROC='getOpenScheduleQuantity' &PROGRAM='rsscxr.p'
               &PARAM="(output divisor,
                        output qty_open,
                        input eff_date,
                        buffer pod_det)"
               &NOAPPERROR=True
               &CATCHERROR=True}
 
      {us/px/pxrun.i &PROC='checkScheduleQtyTolerance' &PROGRAM='porcxr1.p'
               &PARAM="(input divisor,
                        input qty_open,
                        input total_lotserial_qty,
                        input conv_to_pod_um,
                        input poc_tol_pct,
                        input eff_date,
                        input l_config_msg)"
               &NOAPPERROR=True
               &CATCHERROR=True}
 
      if return-value <> {&SUCCESS-RESULT} 
      then do:
         if l_config_msg
         then do:
            l_errlevel = 0.
            {us/bbi/gprun.i ""gpcfmsg.p""
                           "(input 8305,
                             input 0,
                             input program-name(1),
                             input pod_site,
                             input po_vend,
                             input '',
                             input false,
                             output l_errlevel)"}                 
            if l_errlevel <> 0
            then do:
               /* OVERSHIP % EXCEEDS SCHEDULE AS OF <DATE> TOLERANCE: <PCT> */
               {us/bbi/pxmsg.i &MSGNUM=8305 &ERRORLEVEL=l_errlevel
                               &MSGARG1=eff_date
                               &MSGARG2=poc_tol_pct}
               if l_errlevel > 2
               then
                  undo, retry.
            end. /* IF l_errlevel <> 0 */
         end. /* IF l_config_msg */
         if not batchrun
            and c-application-mode <> "API"
            and not(l_config_msg and l_errlevel = 0)
         then do:
            {us/gp/gpwait.i &INCLUDEPAUSE}.
         end. /* IF NOT batchrun  */
      end.
 
      {us/px/pxrun.i &PROC='checkScheduleCostTolerance' &PROGRAM='porcxr1.p'
               &PARAM="(input exch_rate,
                        input exch_rate2,
                        input qty_open,
                        input conv_to_pod_um,
                        input total_lotserial_qty,
                        input poc_tol_cst,
                        input eff_date,
                        input po_curr,
                        input l_config_msg,
                        buffer pod_det)"
               &NOAPPERROR=True
               &CATCHERROR=True}
 
 
      if return-value <> {&SUCCESS-RESULT} 
      then do:
         if l_config_msg
         then do:
            l_errlevel = 0.
            {us/bbi/gprun.i ""gpcfmsg.p""
                           "(input 8306,
                             input 0,
                             input program-name(1),
                             input pod_site,
                             input po_vend,
                             input '',
                             input false,
                             output l_errlevel)"}                 
            if l_errlevel <> 0
            then do:
               /* OVERSHIP COST EXCEEDS SCHEDULE AS OF <DATE> TOLERANCE: <AMT> */ 
               {us/bbi/pxmsg.i &MSGNUM=8306 &ERRORLEVEL=l_errlevel
                               &MSGARG1=eff_date
                               &MSGARG2=poc_tol_pct}
               if l_errlevel > 2
               then
                  undo, retry.
            end. /* IF l_errlevel <> 0 */
         end. /* IF l_config_msg */
         if not batchrun
            and c-application-mode <> "API"
            and not(l_config_msg and l_errlevel = 0)
         then do:
            {us/gp/gpwait.i &INCLUDEPAUSE}.
         end. /* IF NOT batchrun  */
      end.
 
   end. /* IF POD_SCHED */
 
/* this is the end tag that will be only in API mode (not an extraction tag) */
 
   else do:
      /*! TOLERANCE CHECKING FOR NON-SCHEDULED ORDERS */
      if (total_received > pod_qty_ord and pod_qty_ord >= 0)
         or (total_received < pod_qty_ord and pod_qty_ord < 0)
      then do:
 
         overage_qty = total_received - pod_qty_ord.
         /*! CHECK PERCENT OVERSHIP*/
         {us/px/pxrun.i &PROC='checkQtyTolerance' &PROGRAM='porcxr1.p'
                  &PARAM="(input overage_qty,
                           input pod_qty_ord,
                           input poc_tol_pct)"
                   &NOAPPERROR=True
                   &CATCHERROR=True}
 
         if return-value <> {&SUCCESS-RESULT} then
            undo, retry.
 
         {us/px/pxrun.i &PROC='checkCostTolerance' &PROGRAM='porcxr1.p'
                  &PARAM="(input exch_rate,
                           input exch_rate2,
                           input poc_tol_cst,
                           input po_curr,
                           input overage_qty ,
                           buffer pod_det)"
                 &NOAPPERROR=True
                 &CATCHERROR=True}
 
         if return-value <> {&SUCCESS-RESULT} then
            undo, retry.
 
         /*! If overshipment and a blanket order, give user option of
          *  updating blanket order's release quantity */
         if pod_blanket <> "" then do for poddet:
            for first poddet
                where poddet.pod_domain = global_domain
                and   poddet.pod_nbr = pod_det.pod_blanket
                and   poddet.pod_line = pod_det.pod_blnkt_ln
            no-lock: end.
 
            if available poddet and
               poddet.pod_status <> "C" and
               poddet.pod_status <> "X"
            then do:
               /* Update blanket order release quantity? */
               if c-application-mode = "API" then
                  assign {us/mf/mfaiset.i updt_blnkt ttPurchaseOrderTransDet.updateBlanketOrder}.
 
               {us/mf/mfmsg01.i 389 1 updt_blnkt}
 
               /* UPDT_BLNKT_LIST IS A COMMA SEPARATED LIST OF ALL POD_LINE     */
               /* NUMBERS WHICH MUST HAVE THE BLANK PO RELEASE QUANTITY UPDATED */
               if updt_blnkt then do:
 
                  if not can-do(updt_blnkt_list,string(poddet.pod_line))
                  then do:
                     updt_blnkt_list = updt_blnkt_list
                                     + string(poddet.pod_line) + ",".
                  end.
               end.
 
              /* W-INT1 = THE POSITION THE LINE NUMBER NEEDING REMOVAL STARTS ON */
              /* W-INT2 = THE POSITION THE COMMA AFTER THE LINE NUMBER IS ON     */
               else do:
                  if can-do(updt_blnkt_list,string(poddet.pod_line))then do:
                     assign
                        w-int1 = index(updt_blnkt_list,string(poddet.pod_line))
                        w-int2 = (index(substring(updt_blnkt_list,w-int1),
                                  ",")) + w-int1 - 1
                        updt_blnkt_list =
                                 substring(updt_blnkt_list,1,w-int1 - 1) +
                                 substring(updt_blnkt_list,w-int2 + 1).
                  end.
               end.
            end. /* if available poddet */
         end. /* if pod_blanket <> "" */
      end. /* IF (TOTAL_RECEIVED > POD_QTY_ORD AND POD_QTY_ORD > 0) */
   end. /* ELSE DO: */
   undotran = not undotran.
   leave.
end. /* DO ON ERROR UNDO, RETRY: */
